home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Debian / DocBase / DB.pm < prev    next >
Encoding:
Perl POD Document  |  2008-09-07  |  2.5 KB  |  118 lines
  1. # vim:cindent:ts=2:sw=2:et:fdm=marker:cms=\ #\ %s
  2. #
  3. # $Id: DB.pm 129 2008-04-07 18:36:39Z robert $
  4. #
  5.  
  6. package Debian::DocBase::DB;
  7.  
  8. use strict;
  9. use warnings;
  10.  
  11. use MLDBM qw(GDBM_File Storable);
  12. use Fcntl;
  13. use Carp;
  14. use Debian::DocBase::Common;
  15. use Debian::DocBase::Utils;
  16. use Data::Dumper;
  17.  
  18. my $filesdb  = undef;
  19. my $statusdb = undef;
  20.  
  21. sub new { # {{{
  22.     my $class   = shift;
  23.     my $dbfile  = shift;
  24.     my $enckey  = shift;
  25.     my $self    = {
  26.         DB      => {},
  27.         FILE    => $dbfile,
  28.         ENCKEY  => $enckey
  29.  
  30.     };
  31.     bless($self, $class);
  32.     $self->_Init();
  33.     return $self;
  34. } # }}}
  35.  
  36. sub _Init() { # {{{
  37.   my $self = shift;
  38.   # read-only access for `install-docs --status or --dump-db' run as non-root user
  39.   my $readonly = $> != 0;
  40.   return if ($readonly && ! -f $self->{'FILE'}); # db not yet exists and can't be created
  41.     
  42.   my $flags = (!$readonly) ? (O_CREAT | O_RDWR) : O_RDONLY;
  43.  
  44.   tie %{$self->{'DB'}}, 'MLDBM', $self->{'FILE'}, $flags, 0644
  45.     or croak "Can't access $self->{'FILE'}: $!\n";
  46. } # }}}
  47.  
  48. sub PutData($$$) { # {{{
  49.     my ($self, $key, $data)  = @_;
  50.     $self->{'DB'}->{$self->EncodeKey($key)}   = $data;
  51. } # }}}
  52.  
  53. sub GetData($$) { # {{{
  54.   my ($self, $key) = @_;
  55.   return $self->{'DB'}->{$self->EncodeKey($key)}
  56. } # }}}
  57.  
  58. sub GetDB() { # {{{
  59.   my $self = shift;
  60.   return $self->{'DB'};
  61. } # }}}
  62.  
  63. sub RemoveData($$) # {{{
  64. {
  65.   my ($self, $key) = @_;
  66.   delete $self->{'DB'}->{$self->EncodeKey($key)};
  67. } # }}}
  68.  
  69. sub Exists($) { # {{{
  70.   my ($self, $key) = @_;
  71.   my $data = $self->{'DB'}->{$self->EncodeKey($key)};
  72.   return $data and %{$data};
  73. } # }}}
  74.  
  75. sub DumpDB($) { # {{{
  76.   my $self = shift;
  77.   my $db   = $self->{'DB'};
  78.  
  79.   my $dumper = Data::Dumper->new([$db], [$self->{'FILE'}]);
  80.   $dumper->Indent(1);
  81.   $dumper->Terse(1);
  82.   print "Contents of `" .$self->{'FILE'}."\':\n";
  83.   print $dumper->Dump();
  84. } # }}}
  85.  
  86. sub EncodeKey($$) { # {{{
  87.   my ($self, $key) = @_;
  88.   return $key unless $self->{'ENCKEY'};
  89.   $key =~ s/\/+/\//go;
  90.   $key =~ s/^~/~~/o;
  91.   $key =~ s/^$CONTROL_DIR/~1/o;
  92.   $key =~ s/^$LOCAL_CONTROL_DIR/~2/o;
  93.   return $key;
  94. } # }}}
  95.  
  96. sub DecodeKey($$) { # {{{ 
  97.   my ($self, $key) = @_;
  98.   return $key unless $self->{'ENCKEY'};
  99.  
  100.   $key =~ s/^~1/$CONTROL_DIR/o;
  101.   $key =~ s/^~2/$LOCAL_CONTROL_DIR/o;
  102.   $key =~ s/^~~/~/o;
  103.   return $key;
  104. } # }}}
  105.  
  106. ### STATIC FUNCTIONS
  107. sub GetFilesDB() { # {{{
  108.   $filesdb     = Debian::DocBase::DB->new($DB_FILES, 1) unless $filesdb;
  109.   return $filesdb;
  110. } # }}}
  111.  
  112. sub GetStatusDB() { # {{{
  113.   $statusdb     = Debian::DocBase::DB->new($DB_STATUS, 0) unless $statusdb;
  114.   return $statusdb;
  115. } # }}}
  116.  
  117. 1
  118.